VB6高级版API浏览器

VB6高级版API浏览器，可替代内置的WINAPI浏览器，功能更强大，有分类筛选功能，实现快速精准定位，并且附带了几个WIN10风格的控件。

Option ExplicitPrivate Type apiEntry DisplayName As String ' Displayed name (Searchable) Library As String ' Library in which a Sub/Function is located Code As String ' Complete entry code EntryType As Integer ' 1 = Constant, 2 = Declare, 3 = TypeEnd TypePrivate Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongPrivate Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As LongPrivate Const COLOR_BTNSHADOW = 16Private Const COLOR_BTNFACE = 15Private Const COLOR_WINDOW = 5Private Const WM_KEYDOWN = &H100Private vCategories As VariantPrivate vCategoryDeclares(61) As VariantPrivate APIEntries() As apiEntryPrivate DLLEntries() As StringPrivate APIFileLoaded As BooleanPrivate ListSearchIndex As LongPrivate Sub chkNoComments_Click() UpdateFullTextViewEnd SubPrivate Sub chkScope_Click(Index As Integer) UpdateFullTextViewEnd SubPrivate Sub cmbCategories_Click() ChangeListingType cmbEntryType.ListIndexEnd SubPrivate Sub cmbEntryType_Click() SetCategoriesEnabled cmbEntryType.ListIndex = 1 ChangeListingType cmbEntryType.ListIndexEnd SubPrivate Sub cmbLibraryList_Click() ChangeListingType cmbEntryType.ListIndexEnd SubPrivate Sub cmdClear_Click() lstSelectedItems.Clear cmdClear.Enabled = False cmdCopy.Enabled = False cmdInsert.Enabled = False cmdRemove.Enabled = False UpdateFullTextViewEnd SubPrivate Sub cmdCopy_Click() Clipboard.SetText CStr(txtItemText.Text), vbCFTextEnd SubPrivate Sub cmdLoadFile_Click() LoadAPIFile App.Path & "\win32api.txt"End SubPrivate Sub cmdRemove_Click() Dim dwSelIndex As Long dwSelIndex = lstSelectedItems.ListIndex If dwSelIndex > -1 Then lstSelectedItems.RemoveItem dwSelIndex If dwSelIndex > 0 And lstSelectedItems.ListCount > 0 Then dwSelIndex = dwSelIndex - 1 ElseIf lstSelectedItems.ListCount > 0 Then dwSelIndex = 0 Else dwSelIndex = -1 End If If dwSelIndex > -1 Then lstSelectedItems.ListIndex = dwSelIndex Else cmdClear.Enabled = False cmdCopy.Enabled = False cmdInsert.Enabled = False cmdRemove.Enabled = False End If UpdateFullTextView End IfEnd SubPrivate Sub cmdShow_Click() PopupMenu menu_showpopup, , cmdShow.Left, cmdShow.Top cmdShow.HeightEnd SubPrivate Sub Form_Load() On Local Error Resume Next Dim intIndex As Integer vCategories = Array("(None)", "Accessibility", "Audio", "Bitmaps", "Brushes", "Console", "Common Controls", "Common Dialog", "Communication", "Cursor", "Devices", "Dialog Boxes", "Errors", "Events", "Event Logs", "Files & Directories", "File System", "Filled Shapes", "Fonts & Text", "Handles", "Help", "Icons", "INI Files", "Input (General)", "Joysticks", "Keyboard", "Lines & Curves", "Libraries", "Math", "Media Control Interface (MCI)", "Memory", "Menus", "Messages", "Mouse", "National Language Support", "OLE", "Painting & Drawing", "Pens", "Pointers", "Printers", "Pipes", "Processes & Threads", "Rectangles", "Regions", "Registry", "Resources", "Shell", "Shutdown", "Strings", "SIDs", "Synchronization", "System Information", "Tape Devices", "Time", "Timers", "Tool Help", "Tokens", "Window Classes", "Window Procedures", "Window Properties", "Windows", "Winsock", "Other") vCategoryDeclares(0) = " getsystemmetrics systemparametersinfo " vCategoryDeclares(1) = " auxgetdevcaps auxgetnumdevs auxgetvolume auxsetvolume playsound sndplaysound waveoutgetdevcaps waveoutgetnumdevs waveoutgetvolume waveoutsetvolume " vCategoryDeclares(2) = " bitblt extfloodfill getpixel setpixel setpixelv stretchblt " vCategoryDeclares(3) = " createhatchbrush createsolidbrush getbrushorgex setbrushorgex " vCategoryDeclares(4) = " readconsoleoutput writeconsoleoutput readconsoleoutputcharacter readconsoleoutputattribute writeconsoleoutputcharacter writeconsoleoutputattribute fillconsoleoutputcharacter fillconsoleoutputattribute getconsolemode getnumberofconsoleinputevents getconsolescreenbufferinfo getlargestconsolewindowsize getconsolecursorinfo getnumberofconsolemousebuttons setconsolemode setconsoleactivescreenbuffer flushconsoleinputbuffer setconsolescreenbuffersize setconsolecursorposition setconsolecursorinfo scrollconsolescreenbuffer setconsolewindowinfo setconsoletextattribute setconsolectrlhandler generateconsolectrlevent allocconsole freeconsole getconsoletitle setconsoletitle readconsole writeconsole createconsolescreenbuffer getconsolecp setconsolecp getconsoleoutputcp setconsoleoutputcp " vCategoryDeclares(5) = " initcommoncontrolsex " vCategoryDeclares(6) = " choosecolor choosefont commdlgextendederror getopenfilename getsavefilename printdlg " vCategoryDeclares(7) = " setcommstate setcommtimeouts getcommstate getcommtimeouts purgecomm buildcommdcb buildcommdcbandtimeouts transmitcommchar setcommbreak setcommmask clearcommbreak clearcommerror setupcomm escapecommfunction getcommmask getcommproperties getcommmodemstatus waitcommevent " vCategoryDeclares(8) = " clipcursor createcursor destroycursor getclipcursor getcursor getcursorpos loadcursor loadcursorfromfile setcursor setcursorpos setsystemcursor showcursor " vCategoryDeclares(9) = " createdc deletedc deleteobject getdc getstockobject releasedc selectobject " vCategoryDeclares(10) = " messagebox messageboxex messageboxindirect " vCategoryDeclares(11) = " beep getlasterror messagebeep setlasterror setlasterrorex " vCategoryDeclares(12) = " setevent resetevent pulseevent deregistereventsource registereventsource reportevent " vCategoryDeclares(13) = " cleareventlog backupeventlog closeeventlog openeventlog openbackupeventlog readeventlog getnumberofeventlogrecords getoldesteventlogrecord " vCategoryDeclares(14) = " copyfile createdirectory createdirectoryex createfile deletefile findclose findfirstfile findnextfile getdiskfreespace getdiskfreespaceex getdrivetype getfileattributes getfileinformationbyhandle getfilesize getfiletime getfileversioninfo getfileversioninfosize getfullpathname getlogicaldrives getlogicaldrivestrings getshortpathname gettempfilename movefile readfile removedirectory setfileattributes setfilepointer setfiletime verqueryvalue writefile openfile sethandlecount lockfile unlockfile lockfileex unlockfileex getfiletype getstdhandle setstdhandle flushfilebuffers deviceiocontrol setendoffile duplicatehandle setcurrentdirectory getcurrentdirectory movefileex findfirstchangenotification findnextchangenotification findclosechangenotification lopen lclose lcreat llseek lread lwrite hread hwrite " vCategoryDeclares(15) = " getvolumeinformation setvolumelabel " vCategoryDeclares(16) = " chord ellipse fillrect framerect invertrect pie polygon polypolygon rectangle roundrect " vCategoryDeclares(17) = " createfont createfontindirect enumfontfamilies enumfontfamiliesex gettextalign settextalign textout " vCategoryDeclares(18) = " closehandle " vCategoryDeclares(19) = " winhelp " vCategoryDeclares(20) = " destroyicon drawicon drawiconex extracticon extracticonex " vCategoryDeclares(21) = " getprivateprofileint getprivateprofilestring getprofileint getprofilestring writeprivateprofilestring writeprofilestring getprofilesection writeprofilesection getprivateprofilesection writeprivateprofilesection " vCategoryDeclares(22) = " sendinput " vCategoryDeclares(23) = " joygetdevcaps joygetnumdevs joygetpos " vCategoryDeclares(24) = " getasynckeystate getkeyboardstate getkeystate keybd_event setkeyboardstate " vCategoryDeclares(25) = " anglearc arc arcto getarcdirection lineto movetoex polybezier polybezierto polyline polylineto polypolyline setarcdirection " vCategoryDeclares(26) = " loadlibrary loadlibraryex loadmodule freelibrary " vCategoryDeclares(27) = " muldiv " vCategoryDeclares(28) = " mcigeterrorstring mcisendstring " vCategoryDeclares(29) = " copymemory fillmemory globalalloc globalfree globallock globalmemorystatus globalmemorystatusex globalunlock movememory zeromemory globalhandle globalrealloc globalsize globalflags localalloc localfree localhandle locallock localrealloc localsize localunlock localflags virtualalloc virtualfree virtualprotect virtualquery virtualprotectex virtualqueryex heapcreate heapdestroy heapalloc heaprealloc heapfree heapsize " vCategoryDeclares(30) = " createpopupmenu destroymenu getmenu getmenuitemcount getmenuiteminfo getsystemmenu insertmenuitem removemenu setmenuiteminfo trackpopupmenu trackpopupmenuex " vCategoryDeclares(31) = " sendmessage " vCategoryDeclares(32) = " getcapture getdoubleclicktime mouse_event releasecapture setcapture setdoubleclicktime swapmousebutton " vCategoryDeclares(33) = " getcurrencyformat getdateformat getnumberformat getthreadlocale gettimeformat setthreadlocale " vCategoryDeclares(34) = " cotaskmemfree " vCategoryDeclares(35) = " getwindowrgn setwindowrgn " vCategoryDeclares(36) = " createpen createpenindirect " vCategoryDeclares(37) = " isbadreadptr isbadwriteptr isbadstringptr isbadhugereadptr isbadhugewriteptr " vCategoryDeclares(38) = " closeprinter enddoc endpage enumjobs enumprinters openprinter startdoc startpage " vCategoryDeclares(39) = " createnamedpipe getnamedpipehandlestate callnamedpipe waitnamedpipe createpipe connectnamedpipe disconnectnamedpipe setnamedpipehandlestate getnamedpipeinfo peeknamedpipe transactnamedpipe " vCategoryDeclares(40) = " getenvironmentvariable setenvironmentvariable createprocess setprocessshutdownparameters getprocessshutdownparameters getmodulefilename getmodulehandle getprocessheap getprocesstimes openprocess getcurrentprocess getcurrentprocessid exitprocess terminateprocess getexitcodeprocess readprocessmemory writeprocessmemory getthreadcontext setthreadcontext suspendthread resumethread openprocesstoken openthreadtoken createthread createremotethread getcurrentthread getcurrentthreadid setthreadpriority getthreadpriority getthreadtimes exitthread terminatethread getexitcodethread getthreadselectorentry " vCategoryDeclares(41) = " copyrect equalrect inflaterect intersectrect isrectempty offsetrect ptinrect setrect setrectempty subtractrect unionrect " vCategoryDeclares(42) = " combinergn createellipticrgn createellipticrgnindirect createpolygonrgn createpolypolygonrgn createrectrgn createrectrgnindirect createroundrectrgn equalrgn fillrgn framergn getpolyfillmode getrgnbox invertrgn offsetrgn ptinregion rectinregion setpolyfillmode " vCategoryDeclares(43) = " regclosekey regcreatekeyex regdeletekey regdeletevalue regenumkeyex regenumvalue regopenkeyex regqueryvalueex regsetvalueex " vCategoryDeclares(44) = " findresource findresourceex beginupdateresource updateresource endupdateresource loadresource lockresource sizeofresource " vCategoryDeclares(45) = " exitwindowsdialog pickicondlg restartdialog shaddtorecentdocs shbrowseforfolder shell_notifyicon shellexecute shellexecuteex shemptyrecyclebin shfileoperation shfreenamemappings shgetfileinfo shgetfolderlocation shgetfolderpath shgetpathfromidlist shgetspecialfolderlocation shgetspecialfolderpath shqueryrecyclebin shupdaterecyclebinicon " vCategoryDeclares(46) = " lockworkstation " vCategoryDeclares(47) = " charlower charupper comparestring lstrcmp lstrcmpi lstrcpy lstrcpyn lstrlen " vCategoryDeclares(48) = " isvalidsid equalsid equalprefixsid getsidlengthrequired allocateandinitializesid freesid initializesid getsididentifierauthority getsidsubauthority getsidsubauthoritycount getlengthsid copysid " vCategoryDeclares(49) = " waitforsingleobject " vCategoryDeclares(50) = " getcomputername getsyscolor getsystemdirectory gettemppath getusername getversionex getwindowsdirectory setsyscolors " vCategoryDeclares(51) = " settapeposition gettapeposition preparetape erasetape createtapepartition writetapemark gettapestatus gettapeparameters settapeparameters " vCategoryDeclares(52) = " comparefiletime filetimetolocalfiletime filetimetosystemtime getlocaltime getsystemtime getsystemtimeasfiletime gettickcount gettimezoneinformation localfiletimetofiletime setsystemtime systemtimetofiletime getcurrenttime setlocaltime getsysteminfo settimezoneinformation filetimetodosdatetime dosdatetimetofiletime enumtimeformats enumdateformats " vCategoryDeclares(53) = " killtimer queryperformancecounter queryperformancefrequency settimer " vCategoryDeclares(54) = " createtoolhelp32snapshot process32first process32next " vCategoryDeclares(55) = " duplicatetoken gettokeninformation settokeninformation adjusttokenprivileges adjusttokengroups " vCategoryDeclares(56) = " getclassinfo getclassinfoex getclasslong getclassname getwindowlong registerclass registerclassex setclasslong setwindowlong unregisterclass " vCategoryDeclares(57) = " callwindowproc defwindowproc " vCategoryDeclares(58) = " enumpropsex getprop removeprop setprop " vCategoryDeclares(59) = " bringwindowtotop createwindowex destroywindow enablewindow enumchildwindows enumthreadwindows enumwindows findwindow findwindowex flashwindow getactivewindow getdesktopwindow getfocus getforegroundwindow getparent gettopwindow getwindow getwindowrect getwindowtext getwindowtextlength getwindowthreadprocessid ischild isiconic iswindow iswindowenabled iszoomed movewindow setactivewindow setfocus setforegroundwindow setparent setwindowpos setwindowtext showwindow windowfrompoint " vCategoryDeclares(60) = " closesocket connect gethostbyaddr gethostbyname gethostname htonl htons inet_addr inet_nota recv send socket wsacleanup wsagetlasterror wsastartup " vCategoryDeclares(61) = " exitwindowsex sleep sleepex " For intIndex = 0 To UBound(vCategories) cmbCategories.AddItem vCategories(intIndex) Next cmbLibraryList.AddItem "(None)" cmbLibraryList.ListIndex = 0 cmbCategories.ListIndex = 0 cmbEntryType.ListIndex = 1 menu_showpopup.Visible = False LoadAPIFile App.Path & "\win32api.txt" Call menu_showpopup_show_Click(1)End SubPrivate Sub SetCategoriesEnabled(State As Boolean) lblInfo(4).ForeColor = IIf(State, 0, GetSysColor(COLOR_BTNSHADOW)) cmbCategories.BackColor = IIf(State, GetSysColor(COLOR_WINDOW), GetSysColor(COLOR_BTNFACE)) cmbCategories.Enabled = State lblInfo(5).ForeColor = lblInfo(4).ForeColor cmbLibraryList.BackColor = cmbCategories.BackColor cmbLibraryList.Enabled = StateEnd SubPrivate Sub SetCategoriesVisible(State As Boolean) cmbCategories.Visible = State cmbLibraryList.Visible = State lblInfo(4).Visible = State lblInfo(5).Visible = StateEnd SubPrivate Sub Form_Resize() On Local Error Resume Next freDeclareScope.Move Me.ScaleWidth - freDeclareScope.Width - 90, lstItems.Top lstItems.Width = freDeclareScope.Left - (lstItems.Left * 2) - 60 txtItemText.Width = lstItems.Width txtItemText.Height = Me.ScaleHeight - txtItemText.Top - 90 txtSearch.Width = lstItems.Width cmdLoadFile.Move freDeclareScope.Left, (lstItems.Top lstItems.Height) - cmdLoadFile.Height cmdRemove.Move freDeclareScope.Left, txtItemText.Top cmdClear.Move freDeclareScope.Left, cmdRemove.Top cmdRemove.Height 30 cmdInsert.Move freDeclareScope.Left, cmdClear.Top cmdClear.Height 30 cmdCopy.Move freDeclareScope.Left, cmdInsert.Top cmdInsert.Height 30 cmdShow.Move freDeclareScope.Left, (txtItemText.Top txtItemText.Height) - cmdShow.Height lblInfo(6).Move (lstItems.Left lstItems.Width) - lblInfo(6).Width, lblInfo(2).Top lstSelectedItems.Move txtItemText.Left, txtItemText.Top, txtItemText.Width, txtItemText.Height chkNoComments.Move (lstSelectedItems.Left lstSelectedItems.Width) - chkNoComments.Width, lblInfo(3).Top lblCopyright.Move frmMain.ScaleWidth - lblCopyright.Width - 60, lblInfo(0).TopEnd SubPrivate Sub ChangeListingType(intListingType As Integer) Dim intIndex As Integer Dim dwViewCount As Long, dwTotalCount As Long Dim strLibraryFilter As String Dim intCatID As Integer Dim blnAddItem As Boolean If APIFileLoaded Then lstItems.Clear Call LockWindowUpdate(lstItems.hWnd) strLibraryFilter = DLLEntries(cmbLibraryList.ItemData(cmbLibraryList.ListIndex)) intCatID = cmbCategories.ListIndex For intIndex = 0 To UBound(APIEntries) If APIEntries(intIndex).EntryType = intListingType 1 Then blnAddItem = True If strLibraryFilter <> "(None)" Then blnAddItem = (APIEntries(intIndex).Library = strLibraryFilter) If intCatID > 0 Then blnAddItem = blnAddItem And (InStr(vCategoryDeclares(intCatID - 1), " " & LCase(APIEntries(intIndex).DisplayName) & " ") > 0) If blnAddItem Then lstItems.AddItem APIEntries(intIndex).DisplayName lstItems.ItemData(lstItems.NewIndex) = intIndex dwViewCount = dwViewCount 1 End If dwTotalCount = dwTotalCount 1 End If Next Call LockWindowUpdate(0) Dim strCaption As String strCaption = "Displaying " & dwViewCount & " items" If strLibraryFilter <> "(None)" Then strCaption = strCaption & " in """ & cmbLibraryList.Text & """" If intCatID > 0 Then strCaption = strCaption & ", """ & cmbCategories.Text & """" Else If intCatID > 0 Then strCaption = strCaption & " in """ & cmbCategories.Text & """" End If lblInfo(2).Caption = strCaption & ":" End IfEnd SubPrivate Sub LoadAPIFile(strFile As String) If Dir$(strFile) = "" Then MsgBox "Selected file does not exist!" Exit Sub End If Dim intFH As Integer, intPos As Integer, intCommentPos As Integer, intQuotePos As Integer Dim intDLLIndex As Integer Dim strLine As String, strToken As String, strRest As String, strLibraries As String Dim blnAdvanceNext As Boolean Dim dwEntryIndex As Long Dim vDeclare dwEntryIndex = 0 intDLLIndex = 1 strLibraries = "|" intFH = FreeFile Open strFile For Input As #intFH ReDim APIEntries(100) As apiEntry ReDim DLLEntries(50) As String DLLEntries(0) = "(None)" frmMain.MousePointer = vbHourglass Do Until EOF(intFH) Line Input #1, strLine strLine = Trim(strLine) If Not (Left(strLine, 1) = "'" Or Left(strLine, 1) = "") Then intPos = InStr(strLine, " ") If intPos > 0 Then strToken = Left(strLine, intPos - 1) strRest = Right(strLine, Len(strLine) - intPos) intCommentPos = InStrRev(strRest, "'") If intCommentPos > 0 Then intQuotePos = InStrRev(strRest, Chr(34)) If intCommentPos > intQuotePos Or intQuotePos = 0 Then strRest = Left(strRest, intCommentPos - 1) End If End If blnAdvanceNext = False Select Case LCase(strToken) Case "const": ' Const SHUTDOWN_NORETRY = &H1 With APIEntries(dwEntryIndex) .DisplayName = strRest .Code = strLine .EntryType = 1 End With Case "declare": ' Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long vDeclare = Split(strLine, " ", 6) vDeclare(4) = Replace(LCase(UnQuote(vDeclare(4))), ".dll", "") If InStr(strLibraries, "|" & vDeclare(4) & "|") = 0 Then strLibraries = strLibraries & vDeclare(4) & "|" DLLEntries(intDLLIndex) = vDeclare(4) intDLLIndex = intDLLIndex 1 If intDLLIndex > UBound(DLLEntries) Then ReDim Preserve DLLEntries(UBound(DLLEntries) 50) As String End If End If With APIEntries(dwEntryIndex) .DisplayName = vDeclare(2) .Library = vDeclare(4) .Code = strLine .EntryType = 2 End With Case "type": ' Type WIN32_FIND_DATA With APIEntries(dwEntryIndex) .DisplayName = strRest .Code = strLine & vbCrLf .EntryType = 3 End With Case Else: ' Continued code If LCase(strLine) = "end type" Then blnAdvanceNext = True APIEntries(dwEntryIndex).Code = APIEntries(dwEntryIndex).Code & IIf(blnAdvanceNext, "", Space$(4)) & Trim(strLine) & vbCrLf End Select If APIEntries(dwEntryIndex).EntryType <> 3 Or blnAdvanceNext Then dwEntryIndex = dwEntryIndex 1 If dwEntryIndex > UBound(APIEntries) Then ReDim Preserve APIEntries(UBound(APIEntries) 100) As apiEntry End If End If End If DoEvents Loop ReDim Preserve APIEntries(dwEntryIndex - 1) As apiEntry Dim intIndex As Integer cmbLibraryList.Clear For intIndex = 0 To intDLLIndex - 1 cmbLibraryList.AddItem DLLEntries(intIndex) & IIf(InStr(DLLEntries(intIndex), ".") = 0 And Left(DLLEntries(intIndex), 1) <> "(", ".dll", "") cmbLibraryList.ItemData(cmbLibraryList.NewIndex) = intIndex Next ReDim Preserve DLLEntries(intDLLIndex - 1) As String strLibraries = "" cmbLibraryList.ListIndex = 0 frmMain.MousePointer = vbDefault APIFileLoaded = True Call cmbEntryType_Click Close #intFHEnd SubPrivate Function UnQuote(ByVal strStr As String) As String If Left(strStr, 1) = Chr(34) And Right(strStr, 1) = Chr(34) Then strStr = Mid(strStr, 2, Len(strStr) - 2) End If UnQuote = strStrEnd FunctionPrivate Sub lstItems_DblClick() Dim dwIndex As Long Dim blnAddItem As Boolean Dim szPrefix As String, szText As String Dim vSplit As Variant Select Case cmbEntryType.ListIndex Case 0: szPrefix = "Const: " Case 1: szPrefix = "Declare: " Case 2: szPrefix = "Type: " End Select szText = lstItems.List(lstItems.ListIndex) If InStr(szText, " ") > 0 Then vSplit = Split(szText, " ", 5) szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 2, 0)) End If blnAddItem = True For dwIndex = 0 To lstSelectedItems.ListCount - 1 If lstSelectedItems.List(dwIndex) = szPrefix & szText Then blnAddItem = False Exit For End If Next If blnAddItem Then lstSelectedItems.AddItem szPrefix & szText lstSelectedItems.ItemData(lstSelectedItems.NewIndex) = lstItems.ItemData(lstItems.ListIndex) End If cmdClear.Enabled = True cmdCopy.Enabled = True cmdInsert.Enabled = True cmdRemove.Enabled = True UpdateFullTextViewEnd SubPrivate Sub lstItems_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then Call lstItems_DblClickEnd SubPrivate Sub menu_showpopup_show_Click(Index As Integer) menu_showpopup_show(0).Checked = (Index = 0) menu_showpopup_show(1).Checked = (Index = 1) cmdShow.Caption = "Show [" & IIf(Index = 0, "Line", "Full") & "]" Select Case Index Case 0: lstSelectedItems.ZOrder Case 1: txtItemText.ZOrder End SelectEnd SubPrivate Sub txtSearch_Change() Dim dwIndex As Long, dwIdx As Long For dwIndex = ListSearchIndex To lstItems.ListCount - 1 If LCase(Left(lstItems.List(dwIndex), Len(txtSearch.Text))) = LCase(txtSearch.Text) Then If dwIndex 9 < lstItems.ListCount - 1 Then dwIdx = dwIndex 9 Else dwIdx = dwIndex lstItems.ListIndex = dwIdx Exit For End If Next If dwIndex >= lstItems.ListCount Then Exit Sub ' Set search index (optimized searching) ListSearchIndex = dwIndex - 1 lstItems.ListIndex = dwIndexEnd SubPrivate Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Or KeyCode = vbKeyPageDown Or KeyCode = vbKeyPageUp Then Call SendMessage(lstItems.hWnd, WM_KEYDOWN, KeyCode, &O0) KeyCode = 0 ElseIf KeyCode = vbKeyReturn Then Call lstItems_DblClick ElseIf KeyCode = vbKeyBack Then ' Reset search index ListSearchIndex = 0 End IfEnd SubPrivate Sub UpdateFullTextView() Dim dwIndex As Long, dwCodeID As Long, dwCodeIdx As Long Dim szScope As String, szCodeView As String Dim intCommentPos As Integer, intQuotePos As Integer Dim vCode As Variant szScope = IIf(chkScope(0).Checked, "Public ", "Private ") txtItemText.Text = "" If lstSelectedItems.ListCount > -1 Then For dwIndex = 0 To lstSelectedItems.ListCount - 1 dwCodeID = lstSelectedItems.ItemData(dwIndex) vCode = Split(APIEntries(dwCodeID).Code, vbCrLf) For dwCodeIdx = 0 To UBound(vCode) vCode(dwCodeIdx) = LTrimNL(RTrimNL(CStr(vCode(dwCodeIdx)))) If chkNoComments.Checked Then intCommentPos = InStrRev(vCode(dwCodeIdx), "'") If intCommentPos > 0 Then intQuotePos = InStrRev(vCode(dwCodeIdx), Chr(34)) If intCommentPos > intQuotePos Or intQuotePos = 0 Then vCode(dwCodeIdx) = Left(vCode(dwCodeIdx), intCommentPos - 1) End If End If End If vCode(dwCodeIdx) = RTrim(vCode(dwCodeIdx)) Next szCodeView = szCodeView & szScope & RTrimNL(Join(vCode, vbCrLf)) & vbCrLf & vbCrLf Next End If txtItemText.Text = szCodeView txtItemText.SelStart = Len(txtItemText.Text)End SubPrivate Sub txtItemText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) On Local Error Resume Next Dim szText As String, szPrefix As String, szScope As String Dim intPos As Integer Dim vSplit As Variant szScope = IIf(chkScope(0).Checked, "Public ", "Private ") szText = txtItemText.Text If szText > "" Then intPos = InStr(txtItemText.SelStart, szText, vbCrLf) intPos = IIf(intPos > 0, intPos, Len(txtItemText.Text)) szText = RTrimNL(Left(szText, intPos 1)) intPos = InStrRev(szText, szScope) szText = RTrimNL(Right(szText, Len(szText) - intPos 1)) intPos = InStr(szText, vbCrLf) intPos = IIf(intPos > 0, intPos - 1, Len(szText)) szText = Left(szText, intPos) vSplit = Split(szText, " ", 6) szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 3, 2)) szText = StrConv(vSplit(1), vbProperCase) & ": " & RTrimNL(szText) For intPos = 0 To lstSelectedItems.ListCount - 1 If lstSelectedItems.List(intPos) = szText Then Exit For Next lstSelectedItems.ListIndex = intPos End IfEnd SubPrivate Function RTrimNL(szStr As String) As String Dim intPos As Integer If Len(szStr) > 0 Then For intPos = Len(szStr) To 1 Step -1 If Asc(Mid(szStr, intPos, 1)) > 31 Then Exit For Next RTrimNL = IIf(intPos > 0, Left(szStr, intPos), szStr) Else RTrimNL = "" End IfEnd FunctionPrivate Function LTrimNL(szStr As String) As String Dim intPos As Integer For intPos = 1 To Len(szStr) If Asc(Mid(szStr, intPos, 1)) > 31 Then Exit For End If Next LTrimNL = IIf(intPos > 1, Right(szStr, Len(szStr) - intPos 1), szStr)End Function